home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / PGM_TOOL / PREVIEW / CLP2DLFI / DL2.PAS < prev    next >
Pascal/Delphi Source File  |  1995-10-29  |  16KB  |  489 lines
  1. Unit wdl2;
  2.  
  3. Interface
  4.  
  5. Uses Classes, SysUtils, DBFserver, CommonCode, wPreview;
  6.  
  7.     const
  8.         Max=200;
  9.  
  10.     type
  11.         oFldpas=Class(TObject)
  12.         Private
  13.             function strsz(posit:integer):string;
  14.         Public
  15.             procedure dbf2pas(InDir,aDBFfile:string);
  16.         End;
  17.  
  18. Implementation
  19.  
  20. uses NuDelphi;
  21.  
  22. procedure oFldpas.dbf2pas(InDir,aDBFfile:string);
  23. var ff,iii,bb,dd,pp,mm:array [1..Max] of integer;
  24.         ccnt:array [1..8] of integer;
  25.         cc:array [1..8,1..Max] of integer;
  26.         fcnt,icnt,bcnt,dcnt,mcnt,pcnt,filecnt:integer;
  27.         ii,jj,kk,zz,indent:integer;
  28.         tt,tt2,ott:string;
  29.         flist:tstringlist;
  30.         flds:DBFstruct;
  31.         outlines:tstringlist;
  32.       tDB:oDB;
  33. begin
  34.   tDB:=nil;
  35.   indent:=2;
  36.   flds:=DBFstruct.create;
  37.     outlines:=tstringlist.create;
  38.     outlines.clear;
  39.   if Not empty(aDBFfile) then begin
  40.     dbUse(tDB,InDir+'\'+noext(aDBFfile) );
  41.     tDB.GetDBFStruct(flds);
  42.     dbClose(tDB);
  43.     with flds do begin
  44.       if fcount>0 then begin
  45.         tt:=upper(noext(aDBFfile));
  46.         ott:='o'+Copy(tt,1,1)+Copy(lower(tt),2,20);
  47.         tt2:='a'+Copy(tt,1,1)+Copy(lower(tt),2,20);
  48.         for ii:=1 to Max do begin
  49.           ff[ii]:=0;
  50.           iii[ii]:=0;
  51.           bb[ii]:=0;
  52.           dd[ii]:=0;
  53.           pp[ii]:=0;
  54.           for jj:=1 to 8 do cc[jj][ii]:=0;
  55.           ccnt[ii]:=0;
  56.         End;
  57.         fcnt:=0;
  58.         icnt:=0;
  59.         bcnt:=0;
  60.         mcnt:=0;
  61.         dcnt:=0;
  62.         pcnt:=0;
  63.         { go through fields and fill arrays with position numbers }
  64.         for ii:=1 to fcount do begin
  65.           fname[ii]:=lower(fname[ii]);
  66.           { cc[] 1<=10, 2<=20,3<=30,4<=40,5<=60,6<=80,7<=120;8<all else }
  67.           if ftype[ii]='C' then begin
  68.             if fwidth[ii]>255 then begin  { must use pchar }
  69.               pcnt:=pcnt+1;
  70.               pp[pcnt]:=ii;
  71.             End Else Begin
  72.               jj:=8;
  73.               if fwidth[ii]<=120 then begin
  74.                 jj:=7;
  75.               End;
  76.               if fwidth[ii]<=80 then begin
  77.                 jj:=6;
  78.               End;
  79.               if fwidth[ii]<=60 then begin
  80.                 jj:=5;
  81.               End;
  82.               if fwidth[ii]<=40 then begin
  83.                 jj:=4;
  84.               End;
  85.               if fwidth[ii]<=30 then begin
  86.                 jj:=3;
  87.               End;
  88.               if fwidth[ii]<=20 then begin
  89.                 jj:=2;
  90.               End;
  91.               if fwidth[ii]<=10 then begin
  92.                 jj:=1;
  93.               End;
  94.               ccnt[jj]:=ccnt[jj]+1;
  95.               cc[jj,ccnt[jj]]:=ii;
  96.             End;
  97.           End Else
  98.           if ftype[ii]='N' then begin
  99.             { if fwidth[ii]<7 }
  100.               { if fdecs[ii]>0 }
  101.                 { fcnt:=fcnt+1 }
  102.                 { ff[fcnt]:=ii }
  103.               { else }
  104.                 { icnt:=icnt+1 }
  105.                 { iii[icnt]:=ii }
  106.               { endif }
  107.             { else }
  108.               fcnt:=fcnt+1;
  109.               ff[fcnt]:=ii;
  110.             { endif }
  111.           End Else
  112.           if ftype[ii]='L' then begin
  113.             bcnt:=bcnt+1;
  114.             bb[bcnt]:=ii;
  115.           End Else
  116.           if ftype[ii]='D' then begin
  117.             dcnt:=dcnt+1;
  118.             dd[dcnt]:=ii;
  119.           End Else
  120.           if ftype[ii]='M' then begin
  121.             mcnt:=mcnt+1;
  122.             mm[mcnt]:=ii;
  123.           End Else Begin;
  124.             OKbox('Error: Field '+fname[ii]+' Type '+
  125.               ftype[ii]+' unknown');
  126.           End;
  127.         End;
  128.         outlines.add(space(indent)+ott+'=Class(TObject)');
  129.         outlines.add(space(indent)+'Private');
  130.         outlines.add(space(indent)+'  '+tt2+':oDB;');
  131.         outlines.add(space(indent)+'Public');
  132.         outlines.add(space(indent)+'  { variable declarations }');
  133.         outlines.add(space(indent)+'  FromRecNo:longint;');
  134.         outlines.add(space(indent)+'  Locked:boolean;');
  135.         outlines.add('');
  136.         for ii:=1 to 8 do begin
  137.           if ccnt[ii]>0 then begin
  138.             tt:='  ';
  139.             jj:=0;
  140.             for kk:=1 to ccnt[ii] do begin
  141.               if not empty(tt) then begin
  142.                 tt:=tt+','+fname[cc[ii,kk]];
  143.               End Else Begin
  144.                 tt:=tt+fname[cc[ii,kk]];
  145.               End;
  146.               jj:=jj+1;
  147.               if jj>5 then begin
  148.                 outlines.add(space(indent)+tt+strsz(ii));
  149.                 tt:='  ';
  150.                 jj:=0;
  151.               End;
  152.             End;
  153.             if Not empty(tt) then begin
  154.               outlines.add(space(indent)+tt+strsz(ii));
  155.               jj:=0;
  156.             End;
  157.           End;
  158.         End;
  159.         if fcnt>0 then begin
  160.           tt:='  ';
  161.           jj:=0;
  162.           for kk:=1 to fcnt do begin
  163.             if not empty(tt) then begin
  164.               tt:=tt+','+fname[ff[kk]];
  165.             End Else Begin
  166.               tt:=tt+fname[ff[kk]];
  167.             End;
  168.             jj:=jj+1;
  169.             if jj>5 then begin
  170.               outlines.add(space(indent)+tt+':Double;');
  171.               tt:='  ';
  172.               jj:=0;
  173.             End;
  174.           End;
  175.           if Not empty(tt) then begin
  176.             outlines.add(space(indent)+tt+':Double;');
  177.           End;
  178.         End;
  179.         if icnt>0 then begin
  180.           tt:='  ';
  181.           jj:=0;
  182.           for kk:=1 to icnt do begin
  183.             if not empty(tt) then begin
  184.               tt:=tt+','+fname[iii[kk]];
  185.             End Else Begin
  186.               tt:=tt+fname[iii[kk]];
  187.             End;
  188.             jj:=jj+1;
  189.             if jj>5 then begin
  190.               outlines.add(space(indent)+tt+':Integer;');
  191.               tt:='  ';
  192.               jj:=0;
  193.             End;
  194.           End;
  195.           if Not empty(tt) then begin
  196.             outlines.add(space(indent)+tt+':Integer;');
  197.           End;
  198.         End;
  199.         if dcnt>0 then begin
  200.           tt:='  ';
  201.           jj:=0;
  202.           for kk:=1 to dcnt do begin
  203.             if not empty(tt) then begin
  204.               tt:=tt+','+fname[dd[kk]];
  205.             End Else Begin
  206.               tt:=tt+fname[dd[kk]];
  207.             End;
  208.             jj:=jj+1;
  209.             if jj>5 then begin
  210.               outlines.add(space(indent)+tt+':Longint;');
  211.               tt:='  ';
  212.               jj:=0;
  213.             End;
  214.           End;
  215.           if Not empty(tt) then begin
  216.             outlines.add(space(indent)+tt+':Longint;');
  217.           End;
  218.         End;
  219.         if bcnt>0 then begin
  220.           tt:='  ';
  221.           jj:=0;
  222.           for kk:=1 to bcnt do begin
  223.             if not empty(tt) then begin
  224.               tt:=tt+','+fname[bb[kk]];
  225.             End Else Begin
  226.               tt:=tt+fname[bb[kk]];
  227.             End;
  228.             jj:=jj+1;
  229.             if jj>5 then begin
  230.               outlines.add(space(indent)+tt+':Boolean;');
  231.               tt:='  ';
  232.               jj:=0;
  233.             End;
  234.           End;
  235.           if Not empty(tt) then begin
  236.             outlines.add(space(indent)+tt+':Boolean;');
  237.           End;
  238.         End;
  239.         if mcnt>0 then begin
  240.           tt:='  ';
  241.           jj:=0;
  242.           for kk:=1 to mcnt do begin
  243.             if not empty(tt) then begin
  244.               tt:=tt+','+fname[mm[kk]];
  245.             End Else Begin
  246.               tt:=tt+fname[mm[kk]];
  247.             End;
  248.             jj:=jj+1;
  249.             if jj>5 then begin
  250.               outlines.add(space(indent)+tt+':Pchar;  { Memo }');
  251.               tt:='  ';
  252.               jj:=0;
  253.             End;
  254.           End;
  255.           if Not empty(tt) then begin
  256.             outlines.add(space(indent)+tt+':Pchar;  { Memo }');
  257.           End;
  258.         End;
  259.         if pcnt>0 then begin
  260.           tt:='  ';
  261.           jj:=0;
  262.           for kk:=1 to pcnt do begin
  263.             if not empty(tt) then begin
  264.               tt:=tt+','+fname[pp[kk]];
  265.             End Else Begin
  266.               tt:=tt+fname[pp[kk]];
  267.             End;
  268.             jj:=jj+1;
  269.             if jj>5 then begin
  270.               outlines.add(space(indent)+tt+':Pchar;  { Char Field Width>255 }');
  271.               tt:='  ';
  272.               jj:=0;
  273.             End;
  274.           End;
  275.           if Not empty(tt) then begin
  276.             outlines.add(space(indent)+tt+':Pchar;  { Char Field Width>255 }');
  277.           End;
  278.         End;
  279.         outlines.add(space(indent)+'  procedure Init(aDBvar:oDB);');
  280.         outlines.add(space(indent)+'  function  Load(WithLock:Boolean):boolean;');
  281.         outlines.add(space(indent)+'  procedure Save;');
  282.         outlines.add(space(indent)+'end;');
  283.                 outlines.add('');
  284.                 outlines.savetofile(Indir+'\'+noext(aDBFfile)+'.int');
  285.         outlines.clear;
  286.         outlines.add(space(indent)+'procedure '+ott+'.Init(aDBvar:oDB);');
  287.         outlines.add(space(indent)+'begin');
  288.         outlines.add(space(indent)+'  { init vars }');
  289.         outlines.add(space(indent)+'  if dbIsOpen(aDBvar) then '+tt2+':=aDBvar;');
  290.         outlines.add(space(indent)+'  FromRecno:=0;');
  291.         outlines.add(space(indent)+'  Locked:=false;');
  292.         for ii:=1 to 8 do begin
  293.           if ccnt[ii]>0 then begin
  294.             for jj:=1 to ccnt[ii] do begin
  295.               tt:=fname[cc[ii,jj]];
  296.               outlines.add(space(indent)+'  '+tt+':='''';');
  297.             End;
  298.           End;
  299.         End;
  300.         if fcnt>0 then begin
  301.           for jj:=1 to fcnt do begin
  302.             tt:=fname[ff[jj]];
  303.             outlines.add(space(indent)+'  '+tt+':=0;');
  304.           End;
  305.         End;
  306.         if icnt>0 then begin
  307.           for jj:=1 to icnt do begin
  308.             tt:=fname[iii[jj]];
  309.             outlines.add(space(indent)+'  '+tt+':=0;');
  310.           End;
  311.         End;
  312.         if dcnt>0 then begin
  313.           for jj:=1 to dcnt do begin
  314.             tt:=fname[dd[jj]];
  315.             outlines.add(space(indent)+'  '+tt+':=0;');
  316.           End;
  317.         End;
  318.         if bcnt>0 then begin
  319.           for jj:=1 to bcnt do begin
  320.             tt:=fname[bb[jj]];
  321.             outlines.add(space(indent)+'  '+tt+':=false;');
  322.           End;
  323.         End;
  324.         if pcnt>0 then begin
  325.           for jj:=1 to pcnt do begin
  326.             tt:=fname[pp[jj]];
  327.             outlines.add(space(indent)+'  '+tt+':=StrAlloc(MaxMemoSize);   { Field: '+
  328.               ltrim(str2(fwidth[pp[jj]],5))+' chars }');
  329.           End;
  330.         End;
  331.         outlines.add(space(indent)+'end;');
  332.         outlines.add('');
  333.         outlines.add(space(indent)+'function  '+ott+'.Load(WithLock:Boolean):Boolean;');
  334.         outlines.add(space(indent)+'begin');
  335.         outlines.add(space(indent)+'  Init(Nil);');
  336.         outlines.add(space(indent)+'  Result:=true;');
  337.         outlines.add(space(indent)+'  FromRecNo:='+tt2+'.RecNo;');
  338.         outlines.add(space(indent)+'  if WithLock then begin');
  339.         outlines.add(space(indent)+'    Result:='+tt2+'.aLock;');
  340.         outlines.add(space(indent)+'    if not Result then Exit else Locked:=true;');
  341.         outlines.add(space(indent)+'  end;');
  342.         outlines.add(space(indent)+'  { set vars from fields }');
  343.         for ii:=1 to 8 do begin
  344.           if ccnt[ii]>0 then begin
  345.             for jj:=1 to ccnt[ii] do begin
  346.               tt:=fname[cc[ii,jj]];
  347.               outlines.add(space(indent)+'  '+tt+':='+tt2+'.st('''+tt+''');');
  348.             End;
  349.           End;
  350.         End;
  351.         if fcnt>0 then begin
  352.           for jj:=1 to fcnt do begin
  353.             tt:=fname[ff[jj]];
  354.             outlines.add(space(indent)+'  '+tt+':='+tt2+'.f('''+tt+''');');
  355.           End;
  356.         End;
  357.         if icnt>0 then begin
  358.           for jj:=1 to icnt do begin
  359.             tt:=fname[iii[jj]];
  360.             outlines.add(space(indent)+'  '+tt+':='+tt2+'.i('''+tt+''');');
  361.           End;
  362.         End;
  363.         if dcnt>0 then begin
  364.           for jj:=1 to dcnt do begin
  365.             tt:=fname[dd[jj]];
  366.             outlines.add(space(indent)+'  '+tt+':='+tt2+'.d('''+tt+''');');
  367.           End;
  368.         End;
  369.         if bcnt>0 then begin
  370.           for jj:=1 to bcnt do begin
  371.             tt:=fname[bb[jj]];
  372.             outlines.add(space(indent)+'  '+tt+':='+tt2+'.b('''+tt+''');');
  373.           End;
  374.         End;
  375.         if pcnt>0 then begin
  376.           for jj:=1 to pcnt do begin
  377.             tt:=fname[pp[jj]];
  378.             outlines.add(space(indent)+'  '+tt2+'.longs('''+tt+''','+tt+');');
  379.           End;
  380.         End;
  381.         if mcnt>0 then begin
  382.           for jj:=1 to mcnt do begin
  383.             tt:=fname[mm[jj]];
  384.             outlines.add(space(indent)+'  '+tt2+'.m('''+tt+''','+tt+');');
  385.           End;
  386.         End;
  387.         outlines.add(space(indent)+'end;');
  388.         outlines.add('');
  389.         outlines.add(space(indent)+'procedure '+ott+'.Save;');
  390.         outlines.add(space(indent)+'begin');
  391.         outlines.add(space(indent)+'  if not Locked then begin');
  392.         outlines.add(space(indent)+'    OKbox('+tt2+'.Alias+'+
  393.           ''' Error: Tried to save to an unlocked record'');');
  394.         outlines.add(space(indent)+'    Exit;');
  395.         outlines.add(space(indent)+'  end;');
  396.         outlines.add(space(indent)+'  if FromRecNo>0 then '+tt2+'.Go(FromRecNo);');
  397.         outlines.add(space(indent)+'  { set fields from vars }');
  398.         for ii:=1 to 8 do begin
  399.           if ccnt[ii]>0 then begin
  400.             for jj:=1 to ccnt[ii] do begin
  401.               tt:=fname[cc[ii,jj]];
  402.               outlines.add(space(indent)+'  '+tt2+'.ss('''+tt+''','+tt+');');
  403.             End;
  404.           End;
  405.         End;
  406.         if fcnt>0 then begin
  407.           for jj:=1 to fcnt do begin
  408.             tt:=fname[ff[jj]];
  409.             outlines.add(space(indent)+'  '+tt2+'.ff('''+tt+''','+tt+');');
  410.           End;
  411.         End;
  412.         if icnt>0 then begin
  413.           for jj:=1 to icnt do begin
  414.             tt:=fname[iii[jj]];
  415.             outlines.add(space(indent)+'  '+tt2+'.ii('''+tt+''','+tt+');');
  416.           End;
  417.         End;
  418.         if dcnt>0 then begin
  419.           for jj:=1 to dcnt do begin
  420.             tt:=fname[dd[jj]];
  421.             outlines.add(space(indent)+'  '+tt2+'.dd('''+tt+''','+tt+');');
  422.           End;
  423.         End;
  424.         if bcnt>0 then begin
  425.           for jj:=1 to bcnt do begin
  426.             tt:=fname[bb[jj]];
  427.             outlines.add(space(indent)+'  '+tt2+'.bb('''+tt+''','+tt+');');
  428.           End;
  429.         End;
  430.         if pcnt>0 then begin
  431.           for jj:=1 to pcnt do begin
  432.             tt:=fname[pp[jj]];
  433.             outlines.add(space(indent)+'  '+tt2+'.longss('''+tt+''','+tt+');');
  434.           End;
  435.         End;
  436.         if mcnt>0 then begin
  437.           for jj:=1 to mcnt do begin
  438.             tt:=fname[mm[jj]];
  439.             outlines.add(space(indent)+'  '+tt2+'.mm('''+tt+''','+tt+');');
  440.           End;
  441.         End;
  442.         outlines.add(space(indent)+'  '+tt2+'.Unlock;');
  443.         outlines.add(space(indent)+'  Locked:=false;');
  444.         outlines.add(space(indent)+'end;');
  445.         outlines.add('');
  446.         if (pcnt>0) Or (mcnt>0) then begin
  447.           OKbox(upper(noext(aDBFfile))+
  448.            ' Has Memo or Char>255, Requires Special Handling');
  449.         End;
  450.                 outlines.savetofile(Indir+'\'+noext(aDBFfile)+'.imp');
  451.       End;
  452.     End;
  453.   End;
  454.     flds.free;
  455.   outlines.free;
  456. End;
  457.  
  458.  
  459. function oFldpas.strsz(posit:integer):string;
  460. Begin
  461.   Result:='';
  462.   if posit=1 then begin
  463.     Result:=':String[10];';
  464.   End Else
  465.   if posit=2 then begin
  466.     Result:=':String[20];';
  467.   End Else
  468.   if posit=3 then begin
  469.     Result:=':String[30];';
  470.   End Else
  471.   if posit=4 then begin
  472.     Result:=':String[40];';
  473.   End Else
  474.   if posit=5 then begin
  475.     Result:=':String[60];';
  476.   End Else
  477.   if posit=6 then begin
  478.     Result:=':String[80];';
  479.   End Else
  480.   if posit=7 then begin
  481.     Result:=':String[120];';
  482.   End Else
  483.   if posit=8 then begin
  484.     Result:=':String;';
  485.   End;
  486. End;
  487.  
  488. End.
  489.